home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / infor / tsptp.zip / WHET.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-09  |  10KB  |  321 lines
  1. (******************************************************************************)
  2. (*                                  WHET.PAS                                  *)
  3. (*  For details, see Computer Journal article, 'A Synthetic Benchmark',       *)
  4. (*  Jan 1976  pp43-49 Vol. 19 No. 1. Curnow & Wichman.                        *)
  5. (******************************************************************************)
  6.  
  7. PROGRAM Whet(Output);
  8.  
  9. (******************************************************************************)
  10. (*                                TIMING                                      *)
  11. (******************************************************************************)
  12.  
  13. (*$IFNDEF TopSpeed *)
  14.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  15.   USES TPBench;
  16.  (*%E*)
  17. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  18.   IMPORT TSBench *;
  19. (*$ENDIF *)
  20.  
  21. (******************************************************************************)
  22.  
  23.   CONST
  24.     T1  = 0.499975;
  25.     T2  = 0.50025;
  26.     T3  = 2.0;
  27.     Wt  = 10;            (* corresponds to one million Whetstone instructions *)
  28.  
  29.   TYPE
  30.     Rlarray = ARRAY[1..4] OF BmReal;
  31.  
  32.   VAR
  33.     X, Y, Z: BmReal;
  34.     Xx:
  35.       RECORD
  36.         One, Two, Three, Four: BmReal
  37.       END;
  38.  
  39.     E1: Rlarray;
  40.     I, Jj, Kk: BmInt;
  41.     N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11: BmInt;
  42.     J, K, L: 1..4;
  43.  
  44. (*** This procedure should be commented out unless verifying the output     ***
  45.  
  46.   PROCEDURE Pout(N, J, K: BmInt; X1, X2, X3, X4: BmReal);
  47.   BEGIN
  48.     WriteCard(N, 0);
  49.     WriteCard(J, 0);
  50.     WriteCard(K, 0);
  51.     WriteString('  ');
  52.     WriteReal(X1, 15);
  53.     WriteString('  ');
  54.     WriteReal(X2, 15);
  55.     WriteString('  ');
  56.     WriteReal(X3, 15);
  57.     WriteString('  ');
  58.     WriteReal(X4, 15);
  59.     WriteLn
  60.   END Pout;
  61.  
  62. ***)
  63.  
  64.  
  65.   PROCEDURE Proc1(VAR E:Rlarray);
  66.     VAR J: BmInt;
  67.   BEGIN
  68.     J := 0;
  69.     REPEAT
  70.       E[1] := ( E[1] + E[2] + E[3] - E[4]) * T1;
  71.       E[2] := ( E[1] + E[2] - E[3] + E[4]) * T1;
  72.       E[3] := ( E[1] - E[2] + E[3] + E[4]) * T1;
  73.       E[4] := (-E[1] + E[2] + E[3] + E[4]) / T3;
  74.       J    := J + 1;
  75.     UNTIL J = 6
  76.   END;
  77.  
  78.  
  79.   PROCEDURE Proc2(X, Y: BmReal; VAR Z: BmReal);
  80.   BEGIN
  81.     X := T1 * (X + Y);
  82.     Y := T1 * (X + Y);
  83.     Z := (X + Y) / T3
  84.   END;
  85.  
  86.  
  87.   PROCEDURE Proc3;
  88.   BEGIN
  89.     E1[J] := E1[K];
  90.     E1[K] := E1[L];
  91.     E1[L] := E1[J]
  92.   END;
  93.  
  94.  
  95.   PROCEDURE Whetstone;
  96.     VAR I: BmInt;
  97.   BEGIN
  98.  
  99.   (***          Module 1 - Convergence test using real numbers.             ***)
  100.   (*** The execution of this loop was found to be statistically invalid,    ***)
  101.   (*** but is included here for completeness.                               ***)
  102.  
  103.     Xx.One    :=  1.0;
  104.     Xx.Two    := -1.0;
  105.     Xx.Three  := -1.0;
  106.     Xx.Four   := -1.0;
  107.  
  108.     FOR I := 1 TO N1 DO
  109.     BEGIN
  110.       Xx.One    := ( Xx.One + Xx.Two + Xx.Three - Xx.Four) * T1;
  111.       Xx.Two    := ( Xx.One + Xx.Two - Xx.Three + Xx.Four) * T1;
  112.       Xx.Three  := ( Xx.One - Xx.Two + Xx.Three + Xx.Four) * T1;
  113.       Xx.Four   := (-Xx.One + Xx.Two + Xx.Three + Xx.Four) * T1
  114.     END;
  115.  
  116.     (* Pout(N1,N1,N1,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  117.  
  118.     (***        Module 2 - Convergence test using array elements.           ***)
  119.     (*** Modules 2 & 3 use variations of the following transformation       ***)
  120.     (*** statements:                                                        ***)
  121.     (***                                                                    ***)
  122.     (***    x1 = ( x1 + x2 + x3 - x4) * 0.5                                 ***)
  123.     (***    x2 = ( x1 + x2 - x3 + x4) * 0.5                                 ***)
  124.     (***    x3 = ( x1 - x2 + x3 + x4) * 0.5                                 ***)
  125.     (***    x4 = (-x1 + x2 + x3 + x4) * 0.5                                 ***)
  126.     (***                                                                    ***)
  127.     (*** Theoretically this set tends to the solution                       ***)
  128.     (***                                                                    ***)
  129.     (***    x1 = x2 = x3 = x4 = 1.0                                         ***)
  130.     (***                                                                    ***)
  131.     (*** The variables T1, T2, and T3 are terms designed to limit the       ***)
  132.     (*** convergence of the set.                                            ***)
  133.  
  134.     E1[1] :=  1.0;
  135.     E1[2] := -1.0;
  136.     E1[3] := -1.0;
  137.     E1[4] := -1.0;
  138.  
  139.     FOR I := 1 TO N2 DO
  140.     BEGIN
  141.       E1[1] := ( E1[1] + E1[2] + E1[3] - E1[4]) * T1;
  142.       E1[2] := ( E1[1] + E1[2] - E1[3] + E1[4]) * T1;
  143.       E1[3] := ( E1[1] - E1[2] + E1[3] + E1[4]) * T1;
  144.       E1[4] := (-E1[1] + E1[2] + E1[3] + E1[4]) * T1
  145.     END;
  146.  
  147.     (* Pout(N2,N3,N2,E1[1],E1[2],E1[3],E1[4]); *)
  148.  
  149.     (***        Module 3 - Convergence test using procedure calls.          ***)
  150.  
  151.     FOR I := 1 TO N3 DO
  152.       Proc1(E1);
  153.  
  154.     (* Pout(N3,N2,N2,E1[1],E1[2],E1[3],E1[4]); *)
  155.  
  156.     (***        Module 4 - Conditional jumps.                               ***)
  157.     (*** Repeated iterations alternate the value of Jj between 0 and 1.     ***)
  158.  
  159.     Jj := 1;
  160.  
  161.     FOR I := 1 TO N4 DO
  162.     BEGIN
  163.       IF Jj = 1 THEN
  164.         Jj := 2
  165.       ELSE
  166.         Jj := 3;
  167.  
  168.       IF Jj > 2 THEN
  169.         Jj := 0
  170.       ELSE
  171.         Jj := 1;
  172.  
  173.       IF Jj < 1 THEN
  174.         Jj := 1
  175.       ELSE
  176.         Jj := 0;
  177.     END;
  178.  
  179.     (* Pout(N4,Jj,Jj,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  180.  
  181.     (***        Module 5 - Omitted.                                         ***)
  182.  
  183.     (***        Module 6 - Integer arithmetic and array addressing.         ***)
  184.     (*** The values of integers J, K, and L remain unchanged through        ***)
  185.     (*** iterations of the loop.                                            ***)
  186.  
  187.     J := 1;
  188.     K := 2;
  189.     L := 3;
  190.  
  191.     FOR I := 1 TO N6 DO
  192.     BEGIN
  193.       J       := J * (K - J) * (L - K);
  194.       K       := L * K - (L - J) * K;
  195.       L       := (L - K) * (K + J);
  196.       E1[L-1] := (J + K + L);
  197.       E1[K-1] := (J * K * L)
  198.     END;
  199.  
  200.     (* Pout(N6,J,K,E1[1],E1[2],E1[3],E1[4]); *)
  201.  
  202.     (***        Module 7 - Trigonometric functions.                         ***)
  203.     (*** The following loop almost transforms X and Y into themselves and   ***)
  204.     (*** produces results that slowly vary.  (The value of T1 ensures slow  ***)
  205.     (*** convergence, as described above.)                                  ***)
  206.  
  207.     X := 0.5;
  208.     Y := 0.5;
  209.  
  210.     FOR I := 1 TO N7 DO
  211.     BEGIN
  212.       X := T1 * arctan(T3 * sin(X) * cos(X) / (cos(X + Y) + cos(X - Y) - 1.0));
  213.       Y := T1 * arctan(T3 * sin(Y) * cos(Y) / (cos(X + Y) + cos(X - Y) - 1.0))
  214.     END;
  215.  
  216.     (* Pout(N7,J,K,X,X,Y,Y); *)
  217.  
  218.     (***        Module 8 - Procedure calls.                                 ***)
  219.     (*** Values of X, Y, and Z are arbitrary.                               ***)
  220.  
  221.     X := 1.0;
  222.     Y := 1.0;
  223.     Z := 1.0;
  224.  
  225.     FOR I := 1 TO N8 DO
  226.       Proc2(X, Y, Z);
  227.  
  228.     (* Pout(N8,J,K,X,Y,Z,Z); *)
  229.  
  230.     (***        Module 9 - Array references and procedure calls.            ***)
  231.  
  232.     J     := 1;
  233.     K     := 2;
  234.     L     := 3;
  235.     E1[1] := 1.0;
  236.     E1[2] := 2.0;
  237.     E1[3] := 3.0;
  238.  
  239.     FOR I := 1 TO N9 DO
  240.       Proc3;
  241.  
  242.     (* Pout(N9,J,K,E1[1],E1[2],E1[3],E1[4]); *)
  243.  
  244.     (***      Module 10 - Simple integer arithmetic.                        ***)
  245.     (*** The execution of this loop was found to be statistically invalid,  ***)
  246.     (*** but is included here for completeness.                             ***)
  247.  
  248.     Jj := 2;
  249.     Kk := 3;
  250.  
  251.     FOR I := 1 TO N10 DO
  252.     BEGIN
  253.       Jj := Jj + Kk;
  254.       Kk := Jj + Kk;
  255.       Jj := Kk - Jj;
  256.       Kk := Kk - Jj - Jj
  257.     END;
  258.  
  259.     (* Pout(N10,Jj,Kk,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  260.  
  261.     (***        Module 11: Standard functions                               ***)
  262.  
  263.     X := 0.75;
  264.  
  265.     FOR I := 1 TO N11 DO
  266.       X := sqrt(exp(ln(X) / T2));
  267.  
  268.     (* Pout(N11,Jj,Kk,X,X,X,X); *)
  269.  
  270.   END;
  271.  
  272. BEGIN
  273.   WriteLn('Whetstone Benchmark');
  274.  
  275. (*** The variables N1-N11 are counters for Loops 2-11.  Based on earlier    ***)
  276. (*** statistical work (Wichmann, 1970), loops 5 and 10 are omitted from the ***)
  277. (*** test.  The relative weights of modules 1 & 2 have been changed to      ***)
  278. (*** preserve the total yet exercise module 1.  This is reasonable since    ***)
  279. (*** both modules should generate identical code.                           ***)
  280.  
  281.   N1  :=   2 * Wt;                              (* Set the values of the      *)
  282.   N2  :=  10 * Wt;                              (* Module weights.            *)
  283.   N3  :=  14 * Wt;
  284.   N4  := 345 * Wt;
  285.   N5  :=   0;
  286.   N6  := 210 * Wt;
  287.   N7  :=  32 * Wt;
  288.   N8  := 899 * Wt;
  289.   N9  := 616 * Wt;
  290.   N10 :=   0;
  291.   N11 :=  93 * Wt;
  292.  
  293. (******************************************************************************)
  294. (*  Compute the looping overhead.  The Dummy procedure must have some side-   *)
  295. (*  effect so that it is not optimised out of existence.                      *)
  296. (******************************************************************************)
  297.  
  298.   StartTimer;                                   (* Start the clock.           *)
  299.  
  300.   REPEAT
  301.     Dummy;
  302.   UNTIL NullTimesUp;
  303.  
  304. (******************************************************************************)
  305. (*  Now run the benchmark.  Note that the Dummy procedure is also called so   *)
  306. (*  that we can eliminate its overhead from the looping overhead.             *)
  307. (******************************************************************************)
  308.  
  309.   StartTimer;                                   (* Start the clock.           *)
  310.  
  311.   REPEAT
  312.     Whetstone;
  313.     Dummy
  314.   UNTIL BenchTimesUp;
  315.  
  316. (******************************************************************************)
  317.  
  318.   ReportTimes;
  319.  
  320. END.
  321.